perm filename MACROS.LSP[BNF,JRA] blob sn#005919 filedate 1972-10-13 generic text, type T, neo UTF8

(DEFPROP LANG 
 (NIL LANG
      ISITM
      ISITNM
      MAKVAR
      PREPREDLET
      INFPREDLET
      INFN
      PREFN
      VARNO
      VARTBL
      <PREPREDLET>
      <INFPREDLET>
      <PREFN>
      <INFN>
      <IVAR>
      >PREPREDLET<
      >INFPREDLET<
      >PREFN<
      >INFN<
      >IVAR<) 
VALUE)

(DEFPROP ISITM 
 (LAMBDA(L)
  (LIST (QUOTE FUNCTION)
	(LIST (QUOTE LAMBDA)
 	      NIL
	      (LIST (QUOTE PROG)
		    (QUOTE (Z))
		    (LIST (QUOTE RETURN)
			  (LIST (QUOTE COND)
				(LIST (LIST (QUOTE SETQ) (QUOTE Z) (LIST (QUOTE ISIT) (CADR L))) (QUOTE Z))
				(QUOTE (*NIL*)))))))) 
MACRO)

(DEFPROP ISITNM 
 (LAMBDA(L)
  (LIST (QUOTE FUNCTION)
	(LIST (QUOTE LAMBDA)
 	      NIL
	      (LIST (QUOTE PROG)
		    (QUOTE (Z))
		    (LIST (QUOTE RETURN)
			  (LIST (QUOTE COND)
				(LIST (LIST (QUOTE SETQ) (QUOTE Z) (LIST (QUOTE ISITN) (CADR L))) (QUOTE Z))
				(QUOTE (*NIL*)))))))) 
MACRO)

(DEFPROP MAKVAR 
 (LAMBDA(X)
  (PROG (Z)
	(SETQ Z (ASSOC X VARTBL))
	(COND (Z (RETURN (CDR Z))))
	(SETQ VARTBL (CONS (CONS X (SETQ VARNO (ADD1 VARNO))) VARTBL))
	(RETURN VARNO))) 
EXPR)

(DEFPROP PREPREDLET 
 (NIL P Q R E) 
VALUE)

(DEFPROP INFPREDLET 
 (NIL ε < = ≤) 
VALUE)

(DEFPROP INFN 
 (NIL ⊗ //) 
VALUE)

(DEFPROP PREFN 
 (NIL 0 1 A B C F) 
VALUE)

(DEFPROP VARNO 
 (NIL . 0) 
VALUE)

(DEFPROP <PREPREDLET> 
 (LAMBDA NIL (NLRR (QUOTE PREPREDLET) (ISITM PREPREDLET))) 
EXPR)

(DEFPROP <INFPREDLET> 
 (LAMBDA NIL (NLRR (QUOTE INFPREDLET) (ISITM INFPREDLET))) 
EXPR)

(DEFPROP <PREFN> 
 (LAMBDA NIL (NLRR (QUOTE PREFN) (ISITM PREFN))) 
EXPR)

(DEFPROP <INFN> 
 (LAMBDA NIL (NLRR (QUOTE INFN) (ISITM INFN))) 
EXPR)

(DEFPROP <IVAR> 
 (LAMBDA NIL
  (NLRR (QUOTE IVAR)
	(FUNCTION (LAMBDA NIL (PROG (Z) (RETURN (COND ((SETQ Z (ISIT IVAR)) (MAKVAR Z)) (*NIL*)))))))) 
EXPR)

(DEFPROP >PREPREDLET< 
 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((MEMQ (STK1) PREPREDLET) (STK1))))))) 
EXPR)

(DEFPROP >INFPREDLET< 
 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((MEMQ (STK1) INFPREDLET) (STK1))))))) 
EXPR)

(DEFPROP >PREFN< 
 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((MEMQ (STK1) PREFN) (STK1))))))) 
EXPR)

(DEFPROP >INFN< 
 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((MEMQ (STK1) INFN) (STK1))))))) 
EXPR)

(DEFPROP >IVAR< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL
	    (COND ((NUMBERP (STK1)) (CDR (ASSOC (STK1) OUTVAR)))
		  ((EQ (STK1) (QUOTE LENGTH)) LENGTH)
		  ((EQ (STK1) (QUOTE DEPTH)) DEPTH)))))) 
EXPR)